home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / Wirth / Kurven / LineDrawing.mod < prev    next >
Text File  |  1993-08-15  |  3KB  |  91 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       LineDrawing
  3.   :Author.        Kai Bolay
  4.   :Address.       Hoffmannstraße 168, 7250 Leonberg
  5.   :Phone.         07152/22135
  6.   :History.       v1.00 Initial
  7.   :Copyright.     PD
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.2d
  10.   :Imports.       Turtle [Manfred Weigl], IntuiStruct [bne]
  11.   :Contents.      Module supposed by Wirth
  12. ------------------------------------------------------------------------- *)
  13. IMPLEMENTATION MODULE LineDrawing;
  14.  
  15. (* FOLD: IMPORT *)
  16. FROM SYSTEM      IMPORT ADR;
  17. FROM Arts        IMPORT TermProcedure, Assert;
  18. FROM Intuition   IMPORT ScreenPtr, NewScreen, OpenScreen, CloseScreen,
  19.                         WindowPtr, NewWindow, OpenWindow, CloseWindow,
  20.                         WindowFlags, WindowFlagSet, customScreen,
  21.                         IDCMPFlags, IDCMPFlagSet;
  22. FROM Graphics    IMPORT ViewModes, ViewModeSet, SetRGB4;
  23. FROM IntuiStruct IMPORT StructScreen, StructWindow;
  24. FROM Turtle      IMPORT InitTurtleWin, Forward, MoveTo, SetHeading;
  25. (* ENDFD *)
  26.  
  27. (* FOLD: CloseDown *)
  28. PROCEDURE CloseDown;
  29.  
  30. BEGIN
  31.    IF LineDrawWindow # NIL THEN
  32.       CloseWindow (LineDrawWindow);
  33.       LineDrawWindow := NIL;
  34.    END; (* IF *)
  35.    IF LineDrawScreen # NIL THEN
  36.       CloseScreen (LineDrawScreen);
  37.       LineDrawScreen := NIL;
  38.    END; (* IF *)
  39. END CloseDown;
  40. (* ENDFD *)
  41. (* FOLD: OpenUp *)
  42. PROCEDURE OpenUp;
  43.  
  44. VAR NewLineDrawScreen : NewScreen;
  45.     NewLineDrawWindow : NewWindow;
  46.  
  47. BEGIN
  48.    LineDrawWindow := NIL;
  49.    LineDrawScreen := NIL;
  50.    TermProcedure (CloseDown);
  51.    StructScreen (NewLineDrawScreen, 2, 0, 1, ViewModeSet {}, customScreen,
  52.                  ADR ("LineDraw! Have Fun with Wirth..."));
  53.    LineDrawScreen := OpenScreen (NewLineDrawScreen);
  54.    Assert (LineDrawScreen # NIL, ADR ("Can't open Screen!"));
  55.    WITH LineDrawScreen^ DO
  56.       SetRGB4 (ADR (viewPort), 0,  0,  0,  0);
  57.       SetRGB4 (ADR (viewPort), 1, 15, 15, 15);
  58.       SetRGB4 (ADR (viewPort), 2, 15,  0,  0);
  59.       SetRGB4 (ADR (viewPort), 3,  0, 15,  0);
  60.    END; (* WITH *)
  61.    StructWindow (NewLineDrawWindow, 0, 11, LineDrawScreen^.width,
  62.                  LineDrawScreen^.height - 11, 0, 1, IDCMPFlagSet {},
  63.                  WindowFlagSet {backDrop, activate, rmbTrap, borderless},
  64.                  NIL, LineDrawScreen, customScreen);
  65.    LineDrawWindow := OpenWindow (NewLineDrawWindow);
  66.    Assert (LineDrawWindow # NIL, ADR ("Can't open Window!"));
  67.    InitTurtleWin (LineDrawWindow);
  68. END OpenUp;
  69. (* ENDFD *)
  70. (* FOLD: Line *)
  71. PROCEDURE Line (dir45 : INTEGER; dist : INTEGER);
  72.  
  73. BEGIN
  74.    SetHeading ((dir45 + 2) * 45);
  75.    Forward (dist);
  76. END Line;
  77. (* ENDFD *)
  78. (* FOLD: SetXY *)
  79. PROCEDURE SetXY (x, y : INTEGER);
  80.  
  81. BEGIN
  82.    MoveTo (x, y);
  83. END SetXY;
  84. (* ENDFD *)
  85.  
  86. BEGIN
  87.    OpenUp;
  88.    width := LineDrawWindow^.width;
  89.    height := LineDrawWindow^.height;
  90. END LineDrawing.
  91.